home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Tcl / tclMtherr.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-05-31  |  1.9 KB  |  87 lines
  1. /* 
  2.  * tclMatherr.c --
  3.  *
  4.  *    This function provides a default implementation of the
  5.  *    "matherr" function, for SYS-V systems where it's needed.
  6.  *
  7.  * Copyright (c) 1993-1994 The Regents of the University of California.
  8.  * Copyright (c) 1994 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * SCCS: @(#) tclMtherr.c 1.11 96/02/15 11:58:36
  14.  */
  15.  
  16. #include "tclInt.h"
  17. #include <math.h>
  18.  
  19. #ifndef TCL_GENERIC_ONLY
  20. #include "tclPort.h"
  21. #else
  22. #define NO_ERRNO_H
  23. #endif
  24.  
  25. #ifdef NO_ERRNO_H
  26. extern int errno;            /* Use errno from tclExpr.c. */
  27. #define EDOM 33
  28. #define ERANGE 34
  29. #endif
  30.  
  31. /*
  32.  * The following variable is secretly shared with Tcl so we can
  33.  * tell if expression evaluation is in progress.  If not, matherr
  34.  * just emulates the default behavior, which includes printing
  35.  * a message.
  36.  */
  37.  
  38. extern int tcl_MathInProgress;
  39.  
  40. /*
  41.  * The following definitions allow matherr to compile on systems
  42.  * that don't really support it.  The compiled procedure is bogus,
  43.  * but it will never be executed on these systems anyway.
  44.  */
  45.  
  46. #ifndef NEED_MATHERR
  47. struct exception {
  48.     int type;
  49. };
  50. #define DOMAIN 0
  51. #define SING 0
  52. #endif
  53.  
  54. /*
  55.  *----------------------------------------------------------------------
  56.  *
  57.  * matherr --
  58.  *
  59.  *    This procedure is invoked on Sys-V systems when certain
  60.  *    errors occur in mathematical functions.  Type "man matherr"
  61.  *    for more information on how this function works.
  62.  *
  63.  * Results:
  64.  *    Returns 1 to indicate that we've handled the error
  65.  *    locally.
  66.  *
  67.  * Side effects:
  68.  *    Sets errno based on what's in xPtr.
  69.  *
  70.  *----------------------------------------------------------------------
  71.  */
  72.  
  73. int
  74. matherr(xPtr)
  75.     struct exception *xPtr;    /* Describes error that occurred. */
  76. {
  77.     if (!tcl_MathInProgress) {
  78.     return 0;
  79.     }
  80.     if ((xPtr->type == DOMAIN) || (xPtr->type == SING)) {
  81.     errno = EDOM;
  82.     } else {
  83.     errno = ERANGE;
  84.     }
  85.     return 1;
  86. }
  87.